home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / lib / perl5 / site_perl / 5.005 / i386-linux / Net / Netrc.pm < prev   
Encoding:
Perl POD Document  |  2000-01-12  |  3.2 KB  |  188 lines
  1. # Net::Netrc.pm
  2. #
  3. # Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
  4. # This program is free software; you can redistribute it and/or
  5. # modify it under the same terms as Perl itself.
  6.  
  7. package Net::Netrc;
  8.  
  9. use Carp;
  10. use strict;
  11. use FileHandle;
  12. use vars qw($VERSION);
  13.  
  14. $VERSION = "2.08"; # $Id: //depot/libnet/Net/Netrc.pm#4$
  15.  
  16. my %netrc = ();
  17.  
  18. sub _readrc
  19. {
  20.  my $host = shift;
  21.  my($home,$file);
  22.  
  23.  if($^O eq "MacOS") {
  24.    $home = $ENV{HOME} || `pwd`;
  25.    chomp($home);
  26.    $file = ($home =~ /:$/ ? $home . "netrc" : $home . ":netrc");
  27.  } else {
  28.    # Some OS's don't have `getpwuid', so we default to $ENV{HOME}
  29.    $home = eval { (getpwuid($>))[7] } || $ENV{HOME};
  30.    $file = $home . "/.netrc";
  31.  }
  32.  
  33.  my($login,$pass,$acct) = (undef,undef,undef);
  34.  my $fh;
  35.  local $_;
  36.  
  37.  $netrc{default} = undef;
  38.  
  39.  # OS/2 and Win32 do not handle stat in a way compatable with this check :-(
  40.  unless($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'MacOS')
  41.   { 
  42.    my @stat = stat($file);
  43.  
  44.    if(@stat)
  45.     {
  46.      if($stat[2] & 077)
  47.       {
  48.        carp "Bad permissions: $file";
  49.        return;
  50.       }
  51.      if($stat[4] != $<)
  52.       {
  53.        carp "Not owner: $file";
  54.        return;
  55.       }
  56.     }
  57.   }
  58.  
  59.  if($fh = FileHandle->new($file,"r"))
  60.   {
  61.    my($mach,$macdef,$tok,@tok) = (0,0);
  62.  
  63.    while(<$fh>)
  64.     {
  65.      undef $macdef if /\A\n\Z/;
  66.  
  67.      if($macdef)
  68.       {
  69.        push(@$macdef,$_);
  70.        next;
  71.       }
  72.  
  73.      push(@tok, split(/[\s\n]+/, $_));
  74.  
  75. TOKEN:
  76.      while(@tok)
  77.       {
  78.        if($tok[0] eq "default")
  79.         {
  80.          shift(@tok);
  81.          $mach = bless {};
  82.         $netrc{default} = [$mach];
  83.  
  84.          next TOKEN;
  85.         }
  86.  
  87.        last TOKEN
  88.             unless @tok > 1;
  89.  
  90.        $tok = shift(@tok);
  91.  
  92.        if($tok eq "machine")
  93.         {
  94.          my $host = shift @tok;
  95.          $mach = bless {machine => $mach};
  96.  
  97.          $netrc{$host} = []
  98.             unless exists($netrc{$host});
  99.          push(@{$netrc{$host}}, $mach);
  100.         }
  101.        elsif($tok =~ /^(login|password|account)$/)
  102.         {
  103.          next TOKEN unless $mach;
  104.          my $value = shift @tok;
  105.          $mach->{$1} = $value;
  106.         }
  107.        elsif($tok eq "macdef")
  108.         {
  109.          next TOKEN unless $mach;
  110.          my $value = shift @tok;
  111.          $mach->{macdef} = {}
  112.             unless exists $mach->{macdef};
  113.          $macdef = $mach->{machdef}{$value} = [];
  114.         }
  115.       }
  116.     }
  117.    $fh->close();
  118.   }
  119. }
  120.  
  121. sub lookup
  122. {
  123.  my($pkg,$mach,$login) = @_;
  124.  
  125.  _readrc()
  126.     unless exists $netrc{default};
  127.  
  128.  $mach ||= 'default';
  129.  undef $login
  130.     if $mach eq 'default';
  131.  
  132.  if(exists $netrc{$mach})
  133.   {
  134.    if(defined $login)
  135.     {
  136.      my $m;
  137.      foreach $m (@{$netrc{$mach}})
  138.       {
  139.        return $m
  140.             if(exists $m->{login} && $m->{login} eq $login);
  141.       }
  142.      return undef;
  143.     }
  144.    return $netrc{$mach}->[0]
  145.   }
  146.  
  147.  return $netrc{default}->[0]
  148.     if defined $netrc{default};
  149.  
  150.  return undef;
  151. }
  152.  
  153. sub login
  154. {
  155.  my $me = shift;
  156.  
  157.  exists $me->{login}
  158.     ? $me->{login}
  159.     : undef;
  160. }
  161.  
  162. sub account
  163. {
  164.  my $me = shift;
  165.  
  166.  exists $me->{account}
  167.     ? $me->{account}
  168.     : undef;
  169. }
  170.  
  171. sub password
  172. {
  173.  my $me = shift;
  174.  
  175.  exists $me->{password}
  176.     ? $me->{password}
  177.     : undef;
  178. }
  179.  
  180. sub lpa
  181. {
  182.  my $me = shift;
  183.  ($me->login, $me->password, $me->account);
  184. }
  185.  
  186. 1;
  187.  
  188.